PC Users 1998 March/Pc Users extra 6.iso/pshare95/prog/formula1/vcform1.z/ssmdi.bas

BASIC Source File | 1997-09-26 | 25.3 KB | 786 lines

Attribute VB_Name = "SSMDI1"
Option Explicit

'' This variable is used to name the worksheets in each
'' child window.
Global gNewSSCount As Integer

'' These are used for the Format Painter command
Global FormatPainterFlag As Integer
Global FmtPntStartRow As Integer
Global FmtPntEndRow As Integer
Global FmtPntStartCol As Integer
Global FmtPntEndCol As Integer

'' Used for reading metafiles
Type Rect
    bbLeft As Integer
    bbTop As Integer
    bbRight As Integer
    bbBottom As Integer
End Type

Type APMFILEHEADER
    key As Long
    hmf As Integer
    bbox As Rect
    inch As Integer
    reserved As Long
    checksum As Integer
End Type

Sub AddDecimalPlace(AddingDigits As Integer)

    Dim TheFormat As String, TheNewFormat As String, TheChar As String
    Dim TheFormatLen As Integer, FromPointer As Integer
    Dim DecimalPointFound As Integer, ScientificFound As Integer
    Dim ss As Object


    ' This routine parses the format strings associated with the selected cell
    ' and either adds or subtracts a decimal place depending on the setting of
    ' AddingDigits.  It is not internationalized and will only work with
    ' American settings (i.e. period for decimal, comma for thousands).

    ' If no active sheet then don't do anything
    If Not (MainFrame.ActiveForm Is Nothing) Then

        ' Save the object into a variable to save on typing.
        Set ss = MainFrame.ActiveForm.ss

        ' Get the format for the active cell.
        TheFormat = ss.NumberFormat

        ' Don't handle the percentage formats
        If TheFormat = "# ?/?" Or TheFormat = "# ??/??" Then
            Beep
            ss.SetFocus
            Exit Sub
        End If

        ' FromPointer is moved through the original string one character at a time.  Format
        ' characters are copied to TheNewFormat and special cases handled individually.

        TheFormatLen = Len(TheFormat)
        FromPointer = 1

        While FromPointer <= TheFormatLen

            TheChar = Mid$(TheFormat, FromPointer, 1)

            ' Process numbers
            If TheChar = "0" Or TheChar = "#" Then

                ' If adding digits then find the decimal or add one if there is none
                If AddingDigits = True Then
                    DecimalPointFound = False
                    ScientificFound = False
                    Do While FromPointer <= TheFormatLen
                        TheChar = Mid$(TheFormat, FromPointer, 1)
                        If TheChar = "." Then DecimalPointFound = True
                        If TheChar = "E" Or TheChar = "e" Then ScientificFound = True
                        If TheChar <> "0" And TheChar <> "#" And TheChar <> "." And TheChar <> "," Then Exit Do
                        TheNewFormat = TheNewFormat + TheChar
                        FromPointer = FromPointer + 1
                    Loop

                    ' Add the decimal point if it didn't have one before
                    If Not DecimalPointFound Then
                        TheNewFormat = TheNewFormat + "."
                    End If

                    ' Now add the new decimal place and we're done
                    TheNewFormat = TheNewFormat + "0"

                ' Removing Digits
                Else
                    DecimalPointFound = 0
                    ScientificFound = False
                    Do While FromPointer <= TheFormatLen
                        TheChar = Mid$(TheFormat, FromPointer, 1)
                        If TheChar = "." Then DecimalPointFound = Len(TheNewFormat) + 1
                        If TheChar = "E" Or TheChar = "e" Then ScientificFound = True
                        If TheChar <> "0" And TheChar <> "#" And TheChar <> "." And TheChar <> "," Then Exit Do
                        TheNewFormat = TheNewFormat + TheChar
                        FromPointer = FromPointer + 1
                    Loop

                    If DecimalPointFound = 0 Then
                        Beep
                    Else
                        ' Remove the rightmost character (either a 0 or a ".")
                        TheNewFormat = Left$(TheNewFormat, Len(TheNewFormat) - 1)
                        ' If there's only a decimal point left at the end, remove it
                        If Right$(TheNewFormat, 1) = "." Then
                            TheNewFormat = Left$(TheNewFormat, Len(TheNewFormat) - 1)
                        End If
                    End If
                End If

                ' If we weren't at the end of the string, add the last character on
                If FromPointer <= TheFormatLen Then
                    TheNewFormat = TheNewFormat + TheChar
                End If

                ' If scienticic notation, then skip the rest of this number format
                If ScientificFound Then
                    Do While FromPointer <= TheFormatLen
                        FromPointer = FromPointer + 1
                        TheChar = Mid$(TheFormat, FromPointer, 1)
                        TheNewFormat = TheNewFormat + TheChar
                        If TheChar <> "0" And TheChar <> "+" And TheChar <> "-" Then Exit Do
                    Loop
                End If

            ' Skip everything in the boxes (Colors or Conditionals)
            ElseIf TheChar = "[" Then
                Do While FromPointer <= TheFormatLen
                    TheChar = Mid$(TheFormat, FromPointer, 1)
                    TheNewFormat = TheNewFormat + TheChar
                    If TheChar = "]" Then Exit Do
                    FromPointer = FromPointer + 1
                Loop

            'Skip everything in quotes
            ElseIf TheChar = Chr$(34) Then
                Do While FromPointer <= TheFormatLen
                    TheChar = Mid$(TheFormat, FromPointer, 1)
                    TheNewFormat = TheNewFormat + TheChar
                    If TheChar = Chr$(34) Then Exit Do
                    FromPointer = FromPointer + 1
                Loop

            ' Copy the "\" or "_" and the next character without change
            ElseIf TheChar = "_" Or TheChar = "\" Then
                TheNewFormat = TheNewFormat + TheChar
                FromPointer = FromPointer + 1
                TheChar = Mid$(TheFormat, FromPointer, 1)
                TheNewFormat = TheNewFormat + TheChar

            ' All other characters are copied across without changing
            Else
                TheNewFormat = TheNewFormat + TheChar
            End If

            FromPointer = FromPointer + 1
        Wend


        ' Handle General format separately
        If TheNewFormat = "General" Then
            If AddingDigits = True Then
                TheNewFormat = "0.0"
            Else
                Beep
            End If
        End If

        ' Set the decimal places for each cell.
        ss.NumberFormat = TheNewFormat

    End If

    ss.SetFocus

End Sub

Sub C_AutoSum()

   Dim OldRow1%, OldRow2%, OldCol1%, OldCol2%, OldRow%, OldCol%
   Dim TheRow%, TheCol%, TheType%
   Dim TheFormula$

   '' This function partly emulates the function of Excel's AutoSum command.  It automatically
   '' creates a formula that sums the cells above it.  If a range is selected then it will
   '' automatically fill the range with the new sum formula.

   '' Unlike Excel, it only sums cells above it (and not to the left).  This extension could
   '' easily be added using the simple framework below.

   If SSIsActiveForm() Then  ' Make sure there is an active worksheet

      '' Save the original range information for later
      OldRow = MainFrame.ActiveForm.ss.Row            '' Current Row
      OldCol = MainFrame.ActiveForm.ss.Col            '' Current Column
      OldRow1 = MainFrame.ActiveForm.ss.SelStartRow   '' Current Selection
      OldRow2 = MainFrame.ActiveForm.ss.SelEndRow     '' "
      OldCol1 = MainFrame.ActiveForm.ss.SelStartCol   '' "
      OldCol2 = MainFrame.ActiveForm.ss.SelEndCol     '' "

      TheRow = OldRow ' Get the row and colum of the current cell
      TheCol = OldCol ' so we can look above it for a range to sum

      If TheRow = 1 Then  ' Can't do it if this is row 1
         Beep
         Exit Sub

      Else

         '' Look above this cell for numbers or formulas returning numbers.  Ignore all blank cells.

         TheRow = TheRow - 1
         Do
            TheType = MainFrame.ActiveForm.ss.TypeRC(TheRow, TheCol)
            If Abs(TheType) = 1 Then  ' 1 (Number) or -1 (Number Formula) are valid cell types to sum
               Exit Do
            ElseIf Abs(TheType) > 1 Then ' Not a valid type (text, error, logical) so return error
               Beep
               Exit Sub
            End If

            TheRow = TheRow - 1

            If TheRow < 1 Then ' If we made it to the top and have not found a number cell then error
               Beep
               Exit Sub
            End If
         Loop

         '' We found the first number cell, now keep moving up until a non-numeric cell is found
         Do While TheRow > 0
            TheType = MainFrame.ActiveForm.ss.TypeRC(TheRow, TheCol)
            If Abs(TheType) <> 1 Then  ' 1 (Number) or -1 (Number Formula) are valid cell types to sum
               Exit Do
            End If
               TheRow = TheRow - 1
         Loop

         '' Create a new selection based on the range we just found
         MainFrame.ActiveForm.ss.SelStartRow = TheRow + 1
         MainFrame.ActiveForm.ss.SelEndRow = OldRow - 1
         MainFrame.ActiveForm.ss.SelStartCol = OldCol1
         MainFrame.ActiveForm.ss.SelEndCol = OldCol1

         '' The Selection property contains a string representation of the selection
         TheFormula = "Sum(" + MainFrame.ActiveForm.ss.Selection + ")"

         '' Put the new sum into the first cell in the range
         MainFrame.ActiveForm.ss.Row = OldRow1
         MainFrame.ActiveForm.ss.Col = OldCol1
         MainFrame.ActiveForm.ss.Formula = TheFormula

         '' Put everything back the way we started
         MainFrame.ActiveForm.ss.Row = OldRow
         MainFrame.ActiveForm.ss.Col = OldCol
         MainFrame.ActiveForm.ss.SelStartRow = OldRow1
         MainFrame.ActiveForm.ss.SelEndRow = OldRow2
         MainFrame.ActiveForm.ss.SelStartCol = OldCol1
         MainFrame.ActiveForm.ss.SelEndCol = OldCol2

         '' Copy the formula right to fill the range (the range may only be one cell)
         '' Formula cell references will adjust automatically
         MainFrame.ActiveForm.ss.EditCopyRight

      End If
   End If

End Sub

Sub C_Clear()

   '' Clear the current selection(s)
   On Error Resume Next
   If SSIsActiveForm() Then
      MainFrame.ActiveForm.ss.EditClear (F1ClearAll)
   End If

End Sub

Sub C_Copy()

   If SSIsActiveForm() Then
      MainFrame.ActiveForm.ss.EditCopy
   End If

End Sub

Sub C_Cut()

   If SSIsActiveForm() Then
      MainFrame.ActiveForm.ss.EditCut
   End If

End Sub

Sub C_New()

   On Error GoTo CantCreateNewOne
   Dim ss As New frmMDIChild       '' Create a new worksheet and
   ss.Visible = True                '' make it visible
   Exit Sub

CantCreateNewOne:
   MsgBox "Unable to create new worksheet."

End Sub

Sub C_Paste()

   If SSIsActiveForm() Then
      MainFrame.ActiveForm.ss.EditPaste
   End If

End Sub

Sub C_Save()
    Dim response%
   If SSIsActiveForm() Then
      If Left$(MainFrame.ActiveForm.ss.TableName, 5) = "F1Book" Then
         response = SSMDISaveAsFile
      Else
         On Error GoTo CantSave
         MainFrame.ActiveForm.ss.Write MainFrame.ActiveForm.ss.TableName, MainFrame.ActiveForm.ss.Tag
         Exit Sub
CantSave:
         MsgBox "Unable to save " & MainFrame.ActiveForm.ss.TableName
         Exit Sub
      End If
   End If

End Sub

Sub C_Sort(ascending%)

   Dim Srow1%, Srow2%, Scol1%, Scol2%, key1%, key2%, Key3%

   If SSIsActiveForm() Then
      Srow1 = MainFrame.ActiveForm.ss.SelStartRow
      Srow2 = MainFrame.ActiveForm.ss.SelEndRow
      Scol1 = MainFrame.ActiveForm.ss.SelStartCol
      Scol2 = MainFrame.ActiveForm.ss.SelEndCol
      key1 = 1
      key2 = 1
      Key3 = 1
      If Scol2 - Scol1 > 0 Then key2 = 2
      If Scol2 - Scol1 > 1 Then Key3 = 3

      If Not ascending Then
         key1 = -key1
         key2 = -key2
         Key3 = -Key3
      End If
      MainFrame.ActiveForm.ss.Sort3 Srow1, Scol1, Srow2, Scol2, True, key1, key2, Key3
   End If

End Sub

Sub Paint_Reference()

   'MainFrame.RCLabel = MainFrame.ActiveForm.SS.Selection

End Sub

Sub SetBorderStyle(TheStyle As Integer)

    Dim nOutline%, nLeft%, nRight%, nTop%, nBottom%, nShade%
    Dim crOutline&, crLeft&, crRight&, crTop&, crBottom&
    Dim ss As Object

    ' This routine sets the border style of the current selection.  The border
    ' style is passed in through TheStyle.

    ' Get a handle to the current spreadsheet to save typing.
    Set ss = MainFrame.ActiveForm.ss

    ' Set all sides to "Don't Change" (-1 means don't change it)
    nOutline = -1
    nLeft = -1
    nRight = -1
    nTop = -1
    nBottom = -1
    nShade = -1

    ' Set the color of the new borders to Black
    crOutline = 0
    crTop = 0
    crBottom = 0
    crLeft = 0
    crRight = 0

    ' Set the outline for selected cells
    Select Case TheStyle

        Case 0 ' None
            nOutline = 0
            nLeft = 0
            nRight = 0
            nTop = 0
            nBottom = 0

        Case 1 ' Bottom
            nBottom = 1 ' Single Thin Line

        Case 2 ' Left
            nLeft = 1 ' Single Thin Line

        Case 3 ' Right
            nRight = 1 ' Single Thin Line

        Case 4 ' Double Thin Bottom
            nBottom = 6 ' Double Thin Lines

        Case 5 ' Single Medium Bottom
            nBottom = 2 ' Single Medium Line

        Case 6 ' Top/Bottom thin lines
            nTop = 1 ' Single Thin Line
            nBottom = 1 ' Single Thin Line

        Case 7 ' Top Thin, Bottom Double Thin
            nTop = 1 ' Single Thin Line
            nBottom = 6 ' Double Thin Lines

        Case 8 ' Top Thin, Bottom Medium
            nTop = 1 ' Single Thin Line
            nBottom = 2 ' Single Medium Line

        Case 9 ' Outline with separators
            nTop = 1 ' Single Thin Line
            nBottom = 1 ' Single Thin Line
            nLeft = 1 ' Single Thin Line
            nRight = 1 ' Single Thin Line

        Case 10 ' Outline Thin
            nOutline = 1 ' Single Thin Line

        Case 11 ' Outline Medium
            nOutline = 2 ' Single Medium Line

    End Select

    ' Set the new border
    ss.SetBorder nOutline, nLeft, nRight, nTop, nBottom, nShade, crOutline, crLeft, crRight, crTop, crBottom

    ' Clean up
    BorderForm.Hide
    ss.SetFocus

End Sub

Sub SetObjectColor(ThePaletteEntry As Integer)

    Dim fColor As Long
    Dim bColor As Long
    Dim ThePattern As Integer
    Dim TheRow As Integer, TheCol As Integer
    Dim ObjectCount As Integer
    Dim TheObjectCount As Integer
    Dim TheObjectID As Long
    Dim TheObjectType As Integer
    Dim StartRow As Integer, EndRow As Integer, StartCol As Integer, EndCol As Integer
    Dim ss As Object

    ' These are for the object descriptions
    Dim TheStyle As Integer
    Dim TheColor As Long
    Dim TheWeight As Integer

    ' These are for the font description of a cell
    Dim pFont As String
    Dim pSize As Integer
    Dim pBold As Boolean
    Dim pItalic As Boolean
    Dim pUnderline As Boolean
    Dim pStrikeout As Boolean
    Dim pcrColor As Long
    Dim pOutline As Boolean
    Dim pShadow As Boolean

    '' This procedure changes the foreground color of the currently selected
    '' object.  The object may be the font color, or a drawing object like a
    '' line or rectangle, or it may be the foreground of the cells in the
    '' current selection.

    '' Multiple objects are handled, but multiple selections are not.  Therefore,
    '' if there is more than one cell selection, only the current selection
    '' will be changed.  Multiple selections can easily be added if you like.

    '' If the object we are operating on is a cell, there is a global flag
    '' called 'TextOrFillColorFlag' that determines whether we are changing
    '' the cell text color or the cell pattern color.

    ' If no active sheet then don't do anything
    If Not (MainFrame.ActiveForm Is Nothing) Then

        ' Save the object into a variable to save on typing.
        Set ss = MainFrame.ActiveForm.ss

        ' Turn off the Selection Change Event so we don't do all the
        ' toolbar updating while formatting.
        ss.DoSelChange = False

        '' This section handles the drawing objects.

        ' If there are no cell selections then see if there are object selections
        If ss.SelectionCount = 0 Then
            TheObjectCount = ss.ObjGetSelectionCount
            If TheObjectCount > 0 Then
                For ObjectCount = 1 To TheObjectCount
                    ss.ObjGetSelection ObjectCount - 1, TheObjectID
                    TheObjectType = ss.ObjGetType(TheObjectID)

                    ' If it's a line then change the line color
                    If TheObjectType = F1ObjLine Then
                        ss.GetLineStyle TheStyle, TheColor, TheWeight
                        TheColor = ss.PaletteEntry(ThePaletteEntry)
                        ss.SetLineStyle TheStyle, TheColor, TheWeight

                    ' If it's a filled object, change the fill coloe
                    ElseIf TheObjectType = F1ObjArc Or TheObjectType = F1ObjOval Or TheObjectType = F1ObjPolygon Or TheObjectType = F1ObjRectangle Then
                        ss.GetPattern ThePattern, fColor, bColor
                        fColor = ss.PaletteEntry(ThePaletteEntry)
                        ss.SetPattern ThePattern, fColor, bColor
                    End If

                Next ObjectCount
            End If

        '' This section handles cell selections

        Else
            ' Get the selection coordinates.  We have to look at each cell individually.
            StartRow = ss.SelStartRow
            EndRow = ss.SelEndRow
            StartCol = ss.SelStartCol
            EndCol = ss.SelEndCol

            ' Set the selection back to a single cell.
            ss.SelStartRow = ss.Row
            ss.SelStartCol = ss.Col
            ss.SelEndRow = ss.Row
            ss.SelEndCol = ss.Col

            ' Set the foreground color or text color of each cell.
            ' If setting the fill color and the cell has no pattern
            ' then set the pattern to 1 (solid).
            For TheRow = StartRow To EndRow
                For TheCol = StartCol To EndCol
                    ss.Row = TheRow
                    ss.Col = TheCol
                    If TextOrFillColorFlag = 0 Then '' Set Fill Color
                        ss.GetPattern ThePattern, fColor, bColor
                        ThePattern = IIf(ThePattern = 0, 1, ThePattern)
                        fColor = ss.PaletteEntry(ThePaletteEntry)
                        ss.SetPattern ThePattern, fColor, bColor
                    Else '' Set Text Color
                        ss.GetFont pFont, pSize, pBold, pItalic, pUnderline, pStrikeout, pcrColor, pOutline, pShadow
                        pcrColor = ss.PaletteEntry(ThePaletteEntry)
                        ss.SetFont pFont, -pSize, pBold, pItalic, pUnderline, pStrikeout, pcrColor, pOutline, pShadow
                    End If
                Next TheCol
            Next TheRow

            ' Restore selection
            ss.SelStartRow = StartRow
            ss.SelEndRow = EndRow
            ss.SelStartCol = StartCol
            ss.SelEndCol = EndCol
            ss.Row = StartRow
            ss.Col = StartCol
        End If

    ss.DoSelChange = False
    ss.SetFocus

    End If

End Sub

'Sub ShowSSError(ByVal Er As Integer)

'   Dim ssError As String
'
'   If Er <> 0 And Er <> 20023 Then
'      ssError = Space$(256)
'      ssError = MainFrame.ActiveForm.ss.ErrorNumberToText(Er)
'   End If

'End Sub

Sub SSColorDlg(PosX As Long, PosY As Long)

    ' If there is a worksheet then load color form
    If Not (MainFrame.ActiveForm Is Nothing) Then
        Load ColorForm
        ColorForm.Left = PosX
        ColorForm.Top = PosY
        ColorForm.Show
    End If

End Sub

Function SSGetActiveHSS&()
   SSGetActiveHSS& = MainFrame.ActiveForm.ss.ss
End Function

Function SSGetActiveSS()
   SSGetActiveSS = MainFrame.ActiveForm.ss
End Function

Function SSIsActiveForm%()

   Dim bRet%

   bRet% = False
   If Forms.Count > 1 Then
      bRet% = True
   End If
   SSIsActiveForm% = bRet%

End Function

Sub SSMDIOpenFile(OptionalFileName As String)

   Dim FileName As String, FileType%
   Dim Er As Integer

   FileName = Space$(256)
   If Not SSIsActiveForm Then
      Call C_New
      If Not (MainFrame.ActiveForm Is Nothing) Then
         MainFrame.ActiveForm.SetFocus
      End If
   End If

   On Error GoTo Cancel

   If OptionalFileName = "" Then
      FileName = MainFrame.ActiveForm.ss.OpenFileDlgEx("Formula One Demo", MainFrame.hWnd)
      Er = 0
   Else
      FileName = OptionalFileName
      Er = 0
   End If

   If Er <> 0 Then
      'Call ShowSSError(Er)
   Else
      On Error GoTo CantCreateIt
      Dim NewBook As New frmMDIChild
      On Error GoTo UnloadIt

      FileType = NewBook.ss.ReadEx(FileName)
      NewBook.ss.TableName = FileName
      NewBook.Caption = FileName
      NewBook.Visible = True
      NewBook.ss.Tag = FileType
      Exit Sub

Cancel:
      If Err <> 20023 Then
         'Call ShowSSError(Er)
      End If
      Exit Sub

CantCreateIt:
      MsgBox "Unable to create " & FileName
      Exit Sub

UnloadIt:
      Unload NewBook
      MsgBox "Unable to load " & FileName

      Exit Sub
    End If

End Sub

Public Function SSMDISaveAsFile() As Long

   Dim Filespec As F1FileSpec
   Dim Er As Integer
   Dim FileType As Integer


   On Error GoTo Cancel
   MainFrame.ActiveForm.ss.SaveFileDlgEx "Formula One Demo", Filespec

   If Err <> 0 Then
      'Call ShowSSError(Err)
   Else
      On Error GoTo CantWriteIt
      MainFrame.ActiveForm.ss.WriteEx Filespec.Name, Filespec.Type
      MainFrame.ActiveForm.ss.TableName = Filespec.Name
      MainFrame.ActiveForm.Caption = Filespec.Name
      MainFrame.ActiveForm.ss.Tag = Filespec.Type
      SSMDISaveAsFile = 0
      Exit Function

Cancel:
    If Err <> 20023 Then
'        Call ShowSSError(Er)
    End If
        SSMDISaveAsFile = vbCancel
    Exit Function

CantWriteIt:
      MsgBox "Unable to write " & Filespec.Name
      Exit Function
   End If
End Function

Sub UpdateTextAndFillColors()

    Dim ss As Object

    '' This procedure keeps the colors updated on the toolbar
    Set ss = MainFrame.ActiveForm.ss
    'MainFrame.lblTextColor.BackColor = ss.PaletteEntry(CurrentTextColorIndex)
    'MainFrame.lblFillColor.BackColor = ss.PaletteEntry(CurrentFillColorIndex)

End Sub

Public Sub UpdateAlignment()

    Dim WordWrap As Boolean, i As Integer

    For i = 8 To 11
        MainFrame.tlbFormat.Buttons.Item(i).Value = tbrUnpressed
    Next i

    Select Case MainFrame.ActiveForm.ss.HAlign
       Case F1HAlignLeft
          MainFrame.tlbFormat.Buttons.Item(8).Value = tbrPressed

       Case F1HAlignCenter
          MainFrame.tlbFormat.Buttons.Item(9).Value = tbrPressed

       Case F1HAlignRight
          MainFrame.tlbFormat.Buttons.Item(10).Value = tbrPressed

       Case F1HAlignCenterAcrossCells
          MainFrame.tlbFormat.Buttons.Item(11).Value = tbrPressed

    End Select

    For i = 3 To 5
        MainFrame.tlbFormat.Buttons.Item(i).Value = tbrUnpressed
    Next i

    If MainFrame.ActiveForm.ss.FontBold Then MainFrame.tlbFormat.Buttons.Item(3).Value = tbrPressed
    If MainFrame.ActiveForm.ss.FontItalic Then MainFrame.tlbFormat.Buttons.Item(4).Value = tbrPressed
    If MainFrame.ActiveForm.ss.FontUnderline Then MainFrame.tlbFormat.Buttons.Item(5).Value = tbrPressed

End Sub

Public Sub UpdateCBOFontAndSize()

   Dim i%

    For i = 0 To Screen.FontCount - 1

        If StrComp(MainFrame.ActiveForm.ss.FontName, MainFrame.cboFontName.List(i), vbTextCompare) = 0 Then
              MainFrame.cboFontName.ListIndex = i
              MainFrame.cboFontSize.Text = Str(MainFrame.ActiveForm.ss.FontSize / 20)
              Exit Sub
        End If
    Next i

    '' Empty selection since font not found
    MainFrame.cboFontName.ListIndex = -1
    MainFrame.cboFontSize.Text = ""

End Sub